      Subroutine Check_Residual_Error(Nphas,Nposn,Nboun,Fresi)
                                      
!.... Check The Top Residual Error In Each Dof Of Each Phase
      
      Use Constant,          ONLY: Icout
      Use Global_Variables,  ONLY: Mphas,Npoin,Mposn,Neqns,Ndfph
    
      Implicit None  
!.... Subroutine Arguments
      Integer Nphas(Npoin),Nposn(Npoin) 
      Integer Nboun(Mposn)
      Double Precision Fresi(Neqns)
!.... Local Variables
      Integer Mlist,Nlist,Ilist,Ieqns,Ipoin,Idofn,Iphas,Iposn
      Parameter (Mlist=10)
      Integer Llist(Mlist)
      Double Precision Rlist(Mlist)
      Character Ttemp*78,Stemp*78,Rtemp*78
!.... Start Of Execution
      Do Iphas=1,Mphas
         Ttemp=' '
         Write(Ttemp(1:9),'(A,I2)')'Phase:',Iphas
         Stemp=' '
         Rtemp=' '
         Do Idofn=1,Ndfph(Iphas)
            Write(Ttemp(10:20),'(A,I2,A)')'Dof:',Idofn,' : '
            Nlist=0
            Do Ipoin=1,Npoin
               If (Nphas(Ipoin).Ne.Iphas) Cycle
               Iposn=Nposn(Ipoin)+Idofn
               Ieqns=Nboun(Iposn)
               If (Ieqns.Le.0) Cycle
               Call Check_Residual_Error2(Rlist,Nlist,Mlist,Llist,Abs(Fresi(Ieqns)),Ipoin)
               
            End Do
            If (Nlist.Ne.0) Then
               Do Ilist=1,Nlist
                  Ipoin=Llist(Ilist)
                  Iposn=Nposn(Ipoin)+Idofn
                  Ieqns=Nboun(Iposn)
!                 Write(Icout,*)Ipoin,Rlist(Ilist),Fresi(Ieqns)
                  Write(Ttemp(21+(Ilist-1)*5:20+Ilist*5),'(I5)')Ipoin
                  If (Ilist.Le.6) Then
                     Write(Stemp(1+(Ilist-1)*12:Ilist*12),'(1pe12.4)') Fresi(Ieqns)                     
!                    Write(Rtemp(1+(Ilist-1)*12:Ilist*12),'(1pe12.4)') Gsoln(Ieqns)                       
                  End If
               End Do
               Write(Icout,*)Ttemp
               Write(Icout,*)Stemp
               Write(Icout,*)Rtemp
            End If
         End Do
      End Do
      Return
      End


      Subroutine Check_Residual_Error2(Rlist,Nlist,Mlist,Llist,Value,Ipoin)
!.... Find The Top Mlist Values And Its Node
      Implicit None
!.... Subroutine Arguments
      Integer Nlist,Mlist,Llist(Mlist),Ipoin
      Double Precision Value,Rlist(Mlist)
!.... Local Variables
      Integer Ilist,Jlist
!.... Start Of Execution
      Do Ilist=1,Nlist
         If (Rlist(Ilist).Lt.Value) Goto 10
      End Do
   10 Continue
      Do Jlist=Min(Nlist,Mlist-1),Ilist,-1
         Rlist(Jlist+1)=Rlist(Jlist)
         Llist(Jlist+1)=Llist(Jlist)
      End Do
      Nlist=Min(Mlist,Nlist+1)
      If (Ilist.Le.Mlist) Then
         Rlist(Ilist)=Value
         Llist(Ilist)=Ipoin
      End If
      Return
      End